home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / lib / list.ml < prev    next >
Encoding:
Text File  |  1993-09-24  |  3.4 KB  |  171 lines  |  [TEXT/MPS ]
  1. (* Operations on lists *)
  2.  
  3. #open "int";;
  4. #open "exc";;
  5. #open "eq";;
  6.  
  7. let rec length_aux n = function
  8.      []  -> n
  9.   | _::l -> length_aux (succ n) l
  10. ;;
  11.  
  12. let list_length l =
  13.   length_aux 0 l
  14. ;;
  15.  
  16. let prefix @ l1 l2 =
  17.   let rec append = function
  18.        []  -> l2
  19.     | a::l -> a :: append l
  20.   in append l1
  21. ;;
  22.  
  23. let hd = function
  24.     [] -> failwith "hd"
  25.   | a::l -> a
  26. ;;
  27.  
  28. let tl = function
  29.     [] -> failwith "tl"
  30.   | a::l -> l
  31. ;;
  32.  
  33. let rec rev_append = fun
  34.       []   l' -> l'
  35.   | (a::l) l' -> rev_append l (a::l')
  36. ;;
  37.  
  38. let rev l = rev_append l []
  39. ;;
  40.  
  41. let do_list f = do_list_f
  42.  where rec do_list_f = function
  43.      [] -> () | x::l -> f x; do_list_f l
  44. ;;
  45.  
  46. let do_list2 f =
  47.   dol where rec dol = fun
  48.     [] [] -> ()
  49.   | (h1::t1) (h2::t2) -> f h1 h2; dol t1 t2
  50.   | _ _ -> invalid_arg "do_list2"
  51. ;;
  52.  
  53. let map f = function
  54.     [] -> []
  55.   | [a] -> [f a]
  56.   | [a1; a2] -> [f a1; f a2]
  57.   | l -> map_f l
  58.       where rec map_f = function
  59.           [] -> [] | a::l -> f a::map_f l
  60. ;;
  61.  
  62. let map2 f =
  63.   map where rec map = fun
  64.     [] [] -> []
  65.   | (h1::t1) (h2::t2) -> f h1 h2 :: map t1 t2
  66.   | _ _ -> invalid_arg "map2"
  67. ;;
  68.  
  69. let it_list f = it_list_f
  70.  where rec it_list_f a = function
  71.      [] -> a | b::l -> it_list_f (f a b) l
  72. ;;
  73.  
  74. let it_list2 f =
  75.   itl where rec itl a = fun
  76.     [] [] -> a
  77.   | (h1::t1) (h2::t2) -> itl (f a h1 h2) t1 t2
  78.   | _ _ -> invalid_arg "it_list2"
  79. ;;
  80.  
  81. let list_it f l b = list_it_f l
  82.  where rec list_it_f = function
  83.      [] -> b | a::l -> f a (list_it_f l)
  84. ;;
  85.  
  86. let list_it2 f l1 l2 a =
  87.   lit l1 l2
  88.   where rec lit = fun
  89.     [] [] -> a
  90.   | (h1::t1) (h2::t2) -> f h1 h2 (lit t1 t2)
  91.   | _ _ -> invalid_arg "list_it2"
  92. ;;
  93.  
  94. let flat_map f = flat_map_f
  95.  where rec flat_map_f = function
  96.      [] -> [] | x::l -> f x @ flat_map_f l
  97. ;;
  98.  
  99. let for_all p = for_all_p
  100.  where rec for_all_p = function
  101.      [] -> true | a::l -> p a & for_all_p l
  102. ;;
  103.  
  104. let exists p = exists_p
  105.  where rec exists_p = function
  106.      [] -> false | a::l -> p a or exists_p l
  107. ;;
  108.  
  109. let mem x = mem_x
  110.  where rec mem_x = function
  111.      [] -> false | y::l -> x = y or mem_x l
  112. ;;
  113.  
  114. let memq x = memq_x
  115.  where rec memq_x = function
  116.      [] -> false | y::l -> x == y or memq_x l
  117. ;;
  118.  
  119. let except e = except_e
  120.  where rec except_e = function
  121.      [] -> []
  122.    | elem::l -> if e = elem then l else elem::except_e l
  123. ;;
  124.  
  125. let exceptq e = exceptq_e
  126.  where rec exceptq_e = function
  127.      [] -> []
  128.    | elem::l -> if e == elem then l else elem::exceptq_e l
  129. ;;
  130.  
  131. let subtract = fun
  132.     f [] -> f
  133.   | f e  -> subtract_e f
  134.      where rec subtract_e = function
  135.          [] -> []
  136.        | elem::l -> if mem elem e then subtract_e l else elem :: subtract_e l
  137. ;;
  138.  
  139. let union l1 l2 =
  140.   union_rec l1 where rec union_rec = function
  141.     [] -> l2
  142.   | a::l -> if mem a l2 then union_rec l else a :: union_rec l
  143. ;;
  144.  
  145. let intersect l1 l2 =
  146.   inter_rec l1 where rec inter_rec = function
  147.     [] -> []
  148.   | a::l -> if mem a l2 then a :: inter_rec l else inter_rec l
  149. ;;
  150.  
  151. let index a =
  152.   index_rec 0 where rec index_rec i = function
  153.      []  -> raise Not_found
  154.   | b::L -> if a = b then i else index_rec (succ i) L
  155. ;;
  156.  
  157. let assoc name = assoc_rec where rec assoc_rec =
  158.   function [] -> raise Not_found
  159.          | (x,y)::l -> if name = x then y else assoc_rec l
  160. ;;
  161.  
  162. let assq name = assoc_rec where rec assoc_rec =
  163.   function [] -> raise Not_found
  164.          | (x,y)::l -> if name == x then y else assoc_rec l
  165. ;;
  166.  
  167. let mem_assoc name = assoc_rec where rec assoc_rec =
  168.   function [] -> false
  169.          | (x,y)::l -> name = x  or  assoc_rec l
  170. ;;
  171.